home *** CD-ROM | disk | FTP | other *** search
- {$X+R+}
- PROGRAM ladders; { Last update 6/21/95 }
- { FreeWare by Stan Ockers }
-
- USES ANIVGA,MUSIC,CRT,DOS;
-
- CONST
- MAXmazeh = 26 ; { max # of rooms horizontally }
- MAXmazev = 26 ; { max # of rooms vertically }
- MOVEBKG = 96; { Number of pixels from edge to start scrolling }
- BLANK = 20; { Sprite Load # of blank square }
- vanish = 'MST200L8O3dO4CGO5D';
- birdsnd = 'MST150L16O5CEDCDFCDECDFCDEC';
- rollsnd = 'MLO3L32CEGBDFACFADBCEGBDFACFADBCEGBDFACFADBCEGBDFACFADB'+
- 'CEGBDFACFADBCEGBDFACFADBCEGBDFACFADBCEGBDFACFADB';
- uhuh = 'MST100L12O1EL4C';
- picksnd = 'MNT200L8O4DA';
- hallking='MST150O2L8EFGABGL4BL8A+FL4A+L8AFL4AL8EFGABGB>E>DBGBL2>D'+
- 'O3L8EFGABGL4BL8A+FL4A+L8AFL4AL8EFGABGB>E>DBGBL2>D';
- funeral='MNT100O2L4FFF8FA-G8GF8FE8F2';
- TYPE Str80 = String[80];
-
- VAR j,k, { general counting variables }
- vsize,hsize, { current sizes of maze ) }
- row, { row # of current room ( 1 to mazev ) }
- col, { column # of current room ( 1 to mazeh ) }
- level { holds current level }
- :Integer;
-
- maze { holds #'s indicating rooms exits ... }
- { bit 0 = 1 means an exit up }
- { bit 1 = 1 means an exit right }
- { bit 2 = 1 means an exit down }
- { bit 3 = 1 means an exit left }
- { bit 4 = 1 means a carry item in room }
- { bit 5 = 1 means a blocker object in room }
- { bit 6 = 1 means room is a dead end }
- { bit 7 = 1 means there is a torch in room }
- : ARRAY[1..MAXmazev,1..MAXmazeh] OF Byte;
- nextsprite : Word; { holds number of next sprite to allocate }
- roomsprite : ARRAY[1..60,1..2] OF word; {matches room# and sprite in it}
- reg : Registers; { from Dos unit }
- ch : Char;
- faceleft : Boolean; { is man facing left? }
- quitgame,founddoor : Boolean; { to get out cleanly }
- blockedarray : ARRAY[1..60,1..3] OF Byte; { holds row,col & }
- { direction of blocked wall }
-
- oops : Byte; { how many times giving wrong item }
- roll : Boolean; { is man rolling ? }
- ladderpnt,graybrkpnt : Pointer; { pointers to images }
- temppal,blackpal : Palette;
- LABEL NewLevel, { point to start a new level }
- Dejavu; { restart at the same level }
- {**********************************************************************}
- { Return a string nbr long of characters ch. }
-
- FUNCTION Replicate(nbr:Byte;ch:Char) : Str80;
- VAR temp : Str80;
- BEGIN
- IF nbr = 0 THEN temp :=''
- ELSE BEGIN
- IF nbr >80 THEN nbr:=1;
- FillChar(temp,nbr+1,ch);
- temp[0]:=Chr(nbr)
- END; { Else }
- Replicate := temp;
- END; { Replicate }
-
- {**********************************************************************}
- { Convert an integer into a string }
-
- FUNCTION IntToStr(I : LongInt; places : Byte) : Str80;
- VAR temp : String[11];
- len : Byte;
- BEGIN
- Str(i,temp); len := Length(temp);
- IF len < places THEN
- temp := Replicate(places - len, #32) + temp;
- IntToStr := temp;
- END; { Int_To_Str }
-
- {**********************************************************************}
-
- PROCEDURE makemaze;
- TYPE
- shortarray = ARRAY[1..4] OF ShortInt;
- CONST
- delx : shortarray = (0,1,0,-1);
- dely : shortarray = (-1,0,1,0);
- pwrs2 : shortarray = (1,2,4,8);
- VAR
- j,k,q,y,x,d,nd,repcount : ShortInt;
- rmcnt,totroom,deadendtotal : Word;
- t : ARRAY[1..6] OF Byte;
- PROCEDURE adjacent;
- BEGIN
- q := 0;
- IF y>1 THEN
- IF maze[y-1,x] = 0 THEN
- BEGIN Inc(q); t[q]:=0; END;
- IF x<hsize THEN
- IF maze[y,x+1] = 0 THEN
- BEGIN Inc(q); t[q]:=1; END;
- IF y<vsize THEN
- IF maze[y+1,x] = 0 THEN
- BEGIN Inc(q); t[q]:=2; END;
- IF x>1 THEN
- IF maze[y,x-1] = 0 THEN
- BEGIN Inc(q); t[q]:=3; END;
- END; { adjacent }
-
- BEGIN
- Randomize;
- totroom := hsize * vsize;
- FOR j:=1 to vsize DO { zero out maze }
- FOR k:=1 to hsize DO
- maze[j,k] := 0;
- rmcnt := 1; repcount := 0;
- x := Random(hsize)+1;
- y := Random(vsize)+1;
- WHILE rmcnt < totroom DO
- BEGIN
- adjacent;
- IF (q = 0) OR (repcount > 5) THEN
- BEGIN
- repcount := 0;
- REPEAT
- REPEAT
- Inc(y);
- IF y > vsize THEN
- BEGIN y:=1; inc(x); END; {IF}
- IF x > hsize THEN
- x := 1;
- UNTIL maze[y,x] > 0;
- adjacent;
- UNTIL q > 0;
- END; {IF}
- d:= t[Random(q)+1];
- maze[y,x]:=maze[y,x]+pwrs2[d+1];
- y:=y+dely[d+1];
- x:=x+delx[d+1];
- nd:=d-2;
- IF nd<0 THEN
- nd:=nd+4;
- maze[y,x]:=maze[y,x]+pwrs2[nd+1];
- Inc(rmcnt); Inc(repcount);
- END; {WHILE}
- { randomly open up some rooms (otherwise too frustrating) }
- FOR j := 1 TO 3*level DO
- BEGIN
- x := 2 + random(hsize-2); { don't select outside rooms }
- y := 2 + random(vsize-2); { find random point }
- d := random(4);
- CASE d OF
- 0 : BEGIN
- maze[y,x]:= maze[y,x] OR 1;
- Dec(y);
- maze[y,x]:= maze[y,x] OR 4;
- END;
- 1 : BEGIN
- maze[y,x]:= maze[y,x] OR 2;
- Inc(x);
- maze[y,x]:= maze[y,x] OR 8;
- END;
- 2 : BEGIN
- maze[y,x]:= maze[y,x] OR 4;
- Inc(y);
- maze[y,x]:= maze[y,x] OR 1;
- END;
- 3 : BEGIN
- maze[y,x]:= maze[y,x] OR 8;
- Dec(x);
- maze[y,x]:= maze[y,x] OR 2;
- END;
- END; { Case }
- END; { For }
- END; { makemaze }
-
- {**********************************************************************}
-
- PROCEDURE DeadEnds(endsNeeded:Word);
- VAR deadendtotal : Word;
- BEGIN { DeadEnds }
- REPEAT
- MakeMaze;
- deadendtotal := 0; { reset counter }
- { set bit 6 of rooms that are dead ends }
- FOR j := 1 TO vsize DO
- FOR k:= 1 TO hsize DO
- IF {(((maze[j,k] AND 15) =1) AND (maze[j-1,k] IN [12,6])) OR }
- (((maze[j,k] AND 15) =2) AND (maze[j,k+1] IN [10,12])) OR
- (((maze[j,k] AND 15) =4) AND (maze[j+1,k] IN [9,3])) OR
- (((maze[j,k] AND 15) =8) AND (maze[j,k-1] IN [6,10]))
- THEN IF
- NOT ((j IN [1,2]) AND (k IN [1,2])) { not the upper left corner }
- THEN BEGIN
- maze[j,k] := maze[j,k] OR 64;
- inc(deadendtotal);
- END; { THEN }
- UNTIL deadendtotal >= EndsNeeded ; { not enough valid ones }
- END; { DeadEnds }
-
- {**********************************************************************}
-
- PROCEDURE CheckFileErr(name:STRING);
- { in: Error = error value}
- { name = file to deal with}
- {out: If there was an error with the file, the program stops in a clean way}
- BEGIN
- IF Error<>Err_None
- THEN BEGIN
- CloseRoutines;
- WRITELN('Couldn''t access file '+name+' : '+GetErrorMessage);
- halt(1)
- END;
- END;
-
- {**********************************************************************}
- { Get a free deadend position }
- PROCEDURE GetDeadEnd; { col,row are changed (global variables) }
- BEGIN
- REPEAT
- row := Random(vsize) + 1;
- col := Random(hsize) + 1;
- UNTIL (maze[row,col] AND 64 = 64); { dead end }
- maze[row,col] := maze[row,col] AND $BF; { remove as dead end }
- END; { GetDeadEnd }
-
- {**********************************************************************}
- { Go back one room from deadend room and block entrance }
- PROCEDURE GoBackOne; { col,row are changed (global variables) }
- VAR direction,j : Byte;
- BEGIN
- CASE (maze[row,col] AND 15) OF { go to previous room }
- 1 : BEGIN Dec(row); direction := 4; END; { up }
- 2 : BEGIN Inc(col); direction := 8; END; { right }
- 4 : BEGIN Inc(row); direction := 1; END; { down }
- 8 : BEGIN Dec(col); direction := 2; END; { left }
- END; { Case }
- maze[row,col] := maze[row,col] XOR direction; { put up invisible wall }
- j := 1; { find an opening in blocked array }
- WHILE (j<31) AND (blockedarray[j,1] > 0) DO Inc(j);
- blockedarray[j,1] := row; blockedarray[j,2] := col;
- blockedarray[j,3] := direction; { fill in values }
- END; { GoBackOne }
-
- {**********************************************************************}
- PROCEDURE PutGlyph(col,row,block : Integer);
- VAR
- j:Integer;
- BEGIN
- IF ((maze[row,col] AND 1)=0) THEN { No top exit }
- BEGIN
- PutTile(64*col,64*row,block);
- PutTile(64*col+16,64*row,block);
- PutTile(64*col+32,64*row,block);
- PutTile(64*col+48,64*row,block);
- END
- ELSE
- BEGIN { Draw ladder }
- PutTile(64*col,64*row,block);
- PutTile(64*col+32,64*row,10);
- PutTile(64*col+32,64*row+16,10);
- PutTile(64*col+32,64*row+32,10);
- PutTile(64*col+32,64*row+48,10);
- IF ((maze[Pred(row),col] AND 1) = 0) OR { extend floor }
- ((maze[Pred(row),col] AND 10) > 0) { to ladder }
- THEN
- BEGIN
- PutTile(64*col+16,64*row,block);
- PutTile(64*col+48,64*row,block);
- END;
- END; { Else }
- FOR j:= 0 TO 3 DO
- IF((maze[row,col] AND 8)=0) THEN { No left exit }
- BEGIN
- PutTile(64*col,64*row+16*j,block);
- END
- ELSE
- ;
- END; { PutGlyph }
-
- {**********************************************************************}
-
- PROCEDURE drawmaze;
- VAR row,col,block : Integer;
- BEGIN
- block := 10+level;
- MakeTileArea(27,1,1); { clear out the background }
- FOR row := 0 TO 100 DO SpriteN[row] := 0; { no sprites }
- FOR row := 1 TO vsize DO
- FOR col := 1 TO hsize DO
- PutGlyph(col,row,block);
- FOR col:=1 TO hsize DO { last horiz wall }
- BEGIN
- PutTile(64*col,64*vsize+64,block);
- PutTile(64*col+16,64*vsize+64,block);
- PutTile(64*col+32,64*vsize+64,block);
- PutTile(64*col+48,64*vsize+64,block);
- END;
- FOR row:=1 TO vsize DO
- BEGIN
- PutTile(64*hsize+64,64*row,block); { last vert wall }
- PutTile(64*hsize+64,64*row+16,block);
- PutTile(64*hsize+64,64*row+32,block);
- PutTile(64*hsize+64,64*row+48,block);
- END;
- PutTile(64*hsize+64,64*vsize+64,block); { one final chunk }
-
- END; { DrawMaze }
-
-
- {**********************************************************************}
-
- PROCEDURE setsprite(index,x,y: word);
- VAR freepos:Word;
- BEGIN
- Inc(nextsprite);
- SpriteN[nextsprite] := 42+index;
- SpriteX[nextsprite] := 64*col+x;
- SpriteY[nextsprite] := 64*row+y;
- { find free pos in roomsprite array and insert room#, sprite# }
- freepos := 1;
- While roomsprite[freepos,1] > 0 DO Inc(freepos);
- roomsprite[freepos,1] := hsize*Pred(row)+col;
- roomsprite[freepos,2] := nextsprite;
- END; { SetSprite }
-
-
- {**********************************************************************}
-
- PROCEDURE Init;
-
- VAR
- j : Integer;
- BEGIN
- level := 1;
- { load all sprites }
- LoadSprite('lasprite.lib',1); CheckFileErr('lasprite.lib');
- { Sprite LOAD numbers: }
- { 1 - 13 climber images: }
- { 1 face left, 2 face right, 3-5 climb, 6-9 walk left, 10-13 right }
- { 14 torch, no flame 15-19 torch with flame (linked) }
- { 20 black blank area to clear carry square }
- { 21 pow image used when blocker hit }
- { 22 wall lit by torch ( will be used with getimage ) }
- { 23 open door image }
- { 24-27 images showing climber rolling }
- { 28-30 stunned climber images (linked) }
- { 31-38 vanish images for disappearing blocker }
- { 39 locked message for door }
- { 40 ladder image ( will be used with getimage for static bkgd ) }
- { 41 block image ( also used with getimage ) }
- { 42-131 pairs of blocker-carry item images (42 is door 43 is key) }
- LoadFont('modernfo.fnt'); CheckFileErr('modernfo.fnt');
- InitGraph;
- { load all tiles }
- LoadTile('latile.lib',10); CheckFileErr('latile.lib');
- { Tile load numbers: }
- { 10 ladder image }
- { 11-25 fifteen different block images for making maze }
- { 26 image of wall lit by torch }
- { 27 black 16X16 image used to blank out background }
- LoadPalette('ladders.pal',0,temppal); CheckFileErr('ladders.pal');
- FillChar(blackpal,SizeOF(blackpal),0);
- SetSpriteCycle(15,5); { tie torches together }
- SetSpriteCycle(28,3); { tie dizzy together }
- SetSpriteCycle(31,8); { tie fades together }
- SetSplitIndex(1);
- END; { Init }
- {**********************************************************************}
-
- PROCEDURE MakeLevel;
- CONST MAXSPRITECHOICE = 89;
- VAR
- j,spriteord : Integer;
- usedsprite : ARRAY[1..100] OF Boolean;
-
- PROCEDURE PlacePairs(nbr: integer);
- { activate nbr carry items & blockers - blocker goes with next carry }
- VAR
- j : Word;
- BEGIN
- j := 1;
- WHILE j < nbr DO
- BEGIN
- { find dead end for carry item ,spriteord holds ordinal of .. }
- GetDeadEnd;
- SetSprite(spriteord,16,48); { last chosen carry item }
- maze[row,col] := maze[row,col] OR 16;
- { choose next carry item }
- REPEAT
- spriteord := Random(MAXSPRITECHOICE) +1;
- UNTIL Odd(spriteord) AND (usedsprite[spriteord] = FALSE);
- usedsprite[spriteord] := TRUE;
- { place Blocker in position ( to block previous carry item ) }
- GoBackOne; { back up one room }
- SetSprite(spriteord-1,32,24); { activate blocker }
- maze[row,col] := maze[row,col] OR 32; { room contains blocker }
- Inc(j);
- END; { While }
- { now last carry item ( with no blocker ) }
- REPEAT
- row := 1+Random(vsize);
- col := 1+Random(hsize);
- UNTIL maze[row,col] AND 53 = 0; { no carry,blocker or stairs }
- SetSprite(spriteord,16,48); { activate carry item }
- usedsprite[spriteord] := TRUE; { we have used this carry item }
- maze[row,col] := maze[row,col] OR 16; { room contains carry item }
- END; { PlacePairs }
-
- BEGIN { makelevel }
- founddoor := FALSE; roll := FALSE; oops := 0;
- FOR j := 1 TO 100 DO SpriteN[j] := 0; { make sure no sprites left over }
- FillChar(roomsprite,Sizeof(roomsprite),0); { init roomsprite array }
- FillChar(blockedarray,Sizeof(blockedarray),0); { init blocked array }
- FOR j := 1 to 100 DO usedsprite[j] := FALSE;
- vsize := 6+level; hsize := 6+level;
- SetBackgroundMode(scrolling);
- StartVirtualX := 0; StartVirtualY := 0;
- SetBackgroundScrollRange(0,0,64*hsize+128,64*vsize+128);
- SetCycleTime(60); { 0.06 sec ? }
- SetAnimateWindow(16,4,XMAX-4,YMAX-28);
- quitgame := FALSE; ch := #0;
- Color := 206;
- FillBackground(Color);
- GraphTextOrientation := vertical;
- GraphTextColor := 42; GraphTextBackground := 206;
- BackgroundOutTextXY(3,11,'LADDERS');
- GraphTextColor := 45; GraphTextBackground := 45;
- BackgroundOutTextXY(2,10,'LADDERS');
- GraphTextOrientation := horizontal;
- GraphTextColor := 42; GraphTextBackground := 206;
- BackgroundOutTextXY(116,181,'Level:'+ IntToStr(level,2));
- GraphTextColor := 45; GraphTextBackground := 45;
- BackgroundOutTextXY(115,180,'Level:'+ IntToStr(level,2));
- GraphTextColor := 42; GraphTextBackground := 206;
- BackgroundOutTextXY(201,181,'Carrying:');
- GraphTextColor := 45; GraphTextBackground := 45;
- BackgroundOutTextXY(200,180,'Carrying:');
- Color := 168;
- Line(15,3,XMAX-3,3,2); { line around scoll window }
- Line(15,YMAX-27,XMAX-3,YMAX-27,2);
- Line(15,4,15,YMAX-28,2);
- Line(XMAX-3,4,XMAX-3,YMAX-27,2);
- Line(275,179,308,179,2); { line around carry box }
- Line(308,180,308,196,2);
- Line(275,196,307,196,2);
- Line(275,180,275,196,2);
- Color := 25; { black }
- FOR j := 180 TO 195 DO Line(276,j,307,j,2); { clear out carry window }
- FOR j := 4 TO YMAX-28 DO Line(16,j,Xmax-4,j,2);{ clear out scroll window }
- FadeIn(BACKGNDPAGE,500,Fade_Moiree2);
- UpdateOuterArea := 2;
- Randomize;
- DeadEnds(level+3); { make a maze with at least specified # of deadends }
- DrawMaze;
- { Normal sprite numbers ( not load numbers ): }
- { #0 = object being carried BLANK or odd # 43 up }
- { #1 = climber from load #'s 1-13 or 24-30 }
- { #2 = vanish sequence #'s 31-38 }
- { #3 = locked message # 39 }
- { #18 - #49 torches from load #'s 14-19 }
- { #50 up blocker-carryitem pairs }
- { place man in first room row =1 , col = 1 }
- SpriteN[1]:=1; SpriteX[1]:=96; SpriteY[1]:=104;
- SpriteN[0] := BLANK; { object being carried }
- { choose carry items and set in position with blockers }
- nextsprite := 49; { start # -1 for carry sprites }
- GetDeadEnd; { find dead end for door }
- SetSprite(0,16,8); { insert door in screen }
- SpriteX[3] := 64*col+20; { set up 'locked' message coordinates }
- SpriteY[3] := 64*row+32;
- maze[row,col] := maze[row,col] OR 32; { door marked as blocker }
- spriteord :=1; { first carry item is key }
- usedsprite[1] := TRUE; { don't choose key again }
- PlacePairs(level); { now place key & level # blocker & carry items }
- FOR j := 1 TO pred(level) DO { now some more random carry items }
- BEGIN
- REPEAT { choose next carry item }
- spriteord := Random(MAXSPRITECHOICE) +1;
- UNTIL Odd(spriteord) AND (usedsprite[spriteord] = FALSE);
- usedsprite[spriteord] := TRUE; { mark as used }
- REPEAT
- row := 1+Random(vsize); { random placement }
- col := 1+Random(hsize);
- UNTIL maze[row,col] AND 53 = 0; { but no sprites or ladders }
- SetSprite(spriteord,16,48); { o.k. insert it }
- maze[row,col] := maze[row,col] OR 16; { and mark room }
- END; { For }
- { set up torch sprites }
- FOR j := 18 TO 49 DO { get random rooms for torches }
- BEGIN
- REPEAT
- row := Random(vsize) + 1;
- col := Random(hsize) + 1;
- UNTIL maze[row,col] AND 240 = 0; { room without sprites }
- { and not dead end }
- maze[row,col] := maze[row,col] + 128; { mark room as having torch }
- SpriteN[j] := 14; { torch sprite load # }
- SpriteX[j] := 64*Pred(col)+114;
- SpriteY[j] := 64*Pred(row)+84;
- END; { For }
- row := 1; col := 1;
- faceleft := FALSE;
- END; { MakeLevel }
-
- {**********************************************************************}
-
- FUNCTION GetKey : Char; { Get a key add 128 to non-ASCII keys }
- VAR ch : Char;
- BEGIN
- ch := ReadKey;
- IF ch = #0 THEN BEGIN
- ch := ReadKey;
- ch := Chr( Ord(ch) + 128 );
- END; { If }
- GetKey := ch;
- END; { GetKey }
-
- {**********************************************************************}
- { Flush keyboard buffer }
-
- PROCEDURE FlushKey;
- BEGIN
- reg.ah := 1; { check for keystroke }
- Intr ($16,reg);
- IF (reg.flags AND $0040) = 0 THEN { if chars in buffer }
- REPEAT
- reg.ah := 0; { char is ready to go, read it }
- Intr ($16, reg);
- reg.ah := 1; { check for another }
- Intr ($16, reg);
- UNTIL (reg.flags AND $0040) <> 0;
- END; { FlushKey }
-
- {**********************************************************************}
-
- PROCEDURE LightTorch;
- BEGIN
- FOR j := 18 to 49 DO { for each torch sprite }
- IF (SpriteX[j] = 64 * Pred(col) + 114) AND { if x & y match }
- (SpriteY[j] = 64 * Pred(row) + 84 ) THEN
- IF SpriteN[j] = 14 THEN { if not lit }
- BEGIN
- PutTile(64*col+48,64*row+16,26); { light background }
- SpriteN[j] := 15 + Random(5); { light torch }
- END;
- END; { LightTorch }
-
- {**********************************************************************}
-
- PROCEDURE UnBlock;
- VAR j : Integer;
- BEGIN
- j := 1;
- WHILE blockedarray[j,1] > 0 DO
- BEGIN
- IF blockedarray[j,1] = row THEN
- IF blockedarray[j,2] = col THEN
- maze[row,col] := maze[row,col] + blockedarray[j,3];
- Inc(j);
- END; { while }
- END; { UnBlock }
-
- {**********************************************************************}
-
- PROCEDURE UpOne;
- VAR
- j : Integer;
- BEGIN
- REPEAT
- FOR j:=1 TO 16 DO
- BEGIN
- Dec(SpriteY[1],4);
- IF SpriteY[1] < StartVirtualY + MOVEBKG THEN
- Dec(StartVirtualY,4);
- IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
- SpriteN[1] := 3+j MOD 3;
- SpriteX[0] := StartVirtualX + 276;
- SpriteY[0] := StartVirtualY + 180;
- Animate;
- END; { For }
- Dec(row);
- IF maze[row,col] AND 128 = 128 THEN LightTorch;
- IF maze[row,col] AND 48 > 0 THEN Exit; { exit if sprite }
- IF (maze[row,col] AND 10) > 0 THEN Exit; { exit if side paths }
- IF KeyPressed THEN Exit;
- UNTIL maze[row,col] AND 1 = 0
- END; { UpOne }
-
- {**********************************************************************}
-
- PROCEDURE DnOne;
- VAR
- j : Integer;
- BEGIN
- REPEAT
- FOR j:=1 TO 16 DO
- BEGIN
- Inc(SpriteY[1],4);
- IF SpriteY[1] > StartVirtualY + 200 - MOVEBKG THEN
- Inc(StartVirtualY,4);
- IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
- SpriteN[1] := 3+j MOD 3;
- SpriteX[0] := StartVirtualX + 276;
- SpriteY[0] := StartVirtualY + 180;
- Animate;
- END; { For }
- Inc(row);
- IF maze[row,col] AND 128 = 128 THEN LightTorch;
- IF maze[row,col] AND 48 > 0 THEN Exit; { exit if sprite }
- IF (maze[row,col] AND 10) > 0 THEN Exit; { exit if side paths }
- IF KeyPressed THEN Exit;
- UNTIL maze[row,col] AND 4 = 0
- END; { DnOne }
-
- {**********************************************************************}
-
- PROCEDURE LtOne;
- VAR
- j : Integer;
- BEGIN
- faceleft := TRUE; SpriteN[1] := 1;
- REPEAT
- FOR j:=1 TO 16 DO
- BEGIN
- Dec(SpriteX[1],4);
- IF SpriteX[1] < StartVirtualX + MOVEBKG THEN
- Dec(StartVirtualX,4);
- IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
- SpriteN[1] := 6+j MOD 4;
- SpriteX[0] := StartVirtualX + 276;
- SpriteY[0] := StartVirtualY + 180;
- Animate;
- END; { For }
- Dec(col);
- IF maze[row,col] AND 128 = 128 THEN LightTorch;
- IF maze[row,col] AND 48 > 0 THEN Exit; { exit if sprite }
- IF (maze[row,col] AND 5) > 0 THEN Exit; { exit if vert paths }
- IF KeyPressed THEN Exit;
- UNTIL maze[row,col] AND 8 = 0
- END; { LtOne }
-
- {**********************************************************************}
-
- PROCEDURE RtOne;
- VAR
- j : Integer;
- BEGIN
- faceleft := FALSE; SpriteN[1] := 2;
- REPEAT
- FOR j:=1 TO 16 DO
- BEGIN
- Inc(SpriteX[1],4);
- IF SpriteX[1] > StartVirtualX + 320 - MOVEBKG THEN
- Inc(StartVirtualX,4);
- IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
- SpriteN[1] := 10+j MOD 4;
- SpriteX[0] := StartVirtualX + 276;
- SpriteY[0] := StartVirtualY + 180;
- Animate;
- END; { For }
- Inc(col);
- IF maze[row,col] AND 128 = 128 THEN LightTorch;
- IF maze[row,col] AND 48 > 0 THEN Exit; { exit if sprite }
- IF (maze[row,col] AND 5) > 0 THEN Exit; { exit if vert paths }
- IF KeyPressed THEN Exit;
- UNTIL maze[row,col] AND 2 = 0 { While clear Right }
- END; { RtOne }
-
- {**********************************************************************}
-
- PROCEDURE Sparkle; { disappear sequence }
- VAR k : Byte;
- BEGIN
- PlayMusic(vanish);
- SpriteN[2] := 31; { vanish sequence }
- SpriteX[2] := 64*col+32;
- SpriteY[2] := 64*row+16;
- FOR k := 1 TO 8 DO BEGIN Animate; Delay(150); END;
- SpriteN[2] := 0; { remove fade sequence }
- Animate;
- END;
-
- {**********************************************************************}
-
- PROCEDURE HitSprite;
- VAR j,k : Byte;
- room,tone : word;
- BEGIN
- room := hsize*Pred(row)+col;
- j := 1;
- WHILE roomsprite[j,1] > 0 DO { check all rooms containing sprites }
- BEGIN
- IF (roomsprite[j,1] = room) THEN
- BEGIN
- { man runs into obstacle and is carring proper item ... }
- IF ((maze[row,col] AND 32) = 32) AND
- (SpriteN[0] = SpriteN[roomsprite[j,2]]+1)
- THEN BEGIN
- IF j = 1 THEN
- BEGIN
- founddoor := TRUE;
- { put open door sequence here }
- END
- ELSE
- BEGIN
- SpriteN[0] := BLANK; { blank out carried object from bkgd }
- SpriteN[roomsprite[j,2]] := 0; { ... and from screen }
- Sparkle; { disappear sequence }
- maze[row,col] := maze[row,col] XOR 32; { remove sprite mark }
- UnBlock; { remove invisible wall }
- END;
- END
- { man runs into obstacle and is NOT carring proper item ... }
- ELSE
- BEGIN
- IF j = 1 THEN
- BEGIN
- PlayMusic(uhuh); {start uhuh }
- SpriteN[3] := 39; { locked message }
- Animate;
- Delay(900);
- SpriteN[3] := 0; { remove message }
- END
- ELSE
- BEGIN
- Inc(oops);
- GraphTextColor := 42; GraphTextBackground := 206;
- BackgroundOutTextXY(StartVirtualX+21,StartVirtualY+181,
- 'That''s '+ IntToStr(oops,1));
- GraphTextColor := 45; GraphTextBackground := 45;
- BackgroundOutTextXY(StartVirtualX+20,StartVirtualY+180,
- 'That''s '+ IntToStr(oops,1));
- UpDateOuterArea := 2;
- SpriteN[1] := 21; { pow }
- Animate;
- FOR k := 1 TO 3 DO
- BEGIN
- tone := 400;
- FOR j := 1 TO 16 DO
- BEGIN
- Sound(tone);
- Delay(15);
- Dec(tone,30);
- END;
- NoSound;
- END;
- roll := True;
- PlayMusic(rollsnd); {start roll }
- CASE (maze[row,col] AND 15) OF
- 1: UpOne;
- 2: RtOne;
- 4: DnOne;
- 8: LtOne;
- END; { Case }
- SpriteN[1] := 28;
- PlayMusic(birdsnd); {start bird }
- FOR j := 1 TO 30 DO Animate;
- roll := FALSE;
- END;
- END; { If }
- END; { If }
- Inc(j); { Next roomsprite row }
- END; { While }
- END; { HitSprite }
-
- {**********************************************************************}
-
- PROCEDURE Pickup;
- VAR
- j,room,temp : Integer;
- BEGIN
- IF maze[row,col] AND 16 = 16 THEN { carry item in room }
- BEGIN
- PlayMusic(picksnd); {start pick }
- room := hsize*Pred(row)+col; j := 1; { find room }
- WHILE roomsprite[j,1] <> room DO Inc(j); { and item }
- IF SpriteN[0] = BLANK THEN { not carrying anything }
- BEGIN
- SpriteN[0] := SpriteN[roomsprite[j,2]]; {carry #=sprite load #}
- SpriteN[roomsprite[j,2]] := 0; { sprite no longer appears }
- maze[row,col] := maze[row,col] XOR 16; { remove sprite mark }
- END
- ELSE { must be carrying something }
- BEGIN { switch carry items }
- temp := SpriteN[roomsprite[j,2]]; { save room sprite load # }
- SpriteN[roomsprite[j,2]] := SpriteN[0]; { carried into room }
- SpriteN[0] := BLANK; Animate; { wipe out screen image }
- Animate; { from both pages }
- SpriteN[0] := temp; { room sprite load # into carry }
- END;
- END;
- END; { Pickup }
-
- {**********************************************************************}
-
- PROCEDURE SelectLevel;
- VAR j : Byte;
- ch : Char;
- BEGIN
- FOR j := 0 TO 100 DO SpriteN[j] := 0; { get rid of all sprites }
- Animate;
- SetBackgroundMode(static);
- StartVirtualX := 0; StartVirtualY := 0;
- FillBackground(33);
- GraphTextColor := 5; GraphTextBackground := 0;
- FOR j := 0 TO 12 DO
- BEGIN
- BackgroundOutTextXY(3,12*j+22,#32#16);
- BackgroundOutTextXY(299,12*j+22,#17#32);
- END;
- BackgroundOutTextXY(3,6,#32+Replicate(37,#31)+#32);
- BackgroundOutTextXY(3,180,#32+Replicate(37,#30)+#32);
- Color := 3;
- Line(10,10,306,10,2);
- Line(10,190,306,190,2);
- Line(10,10,10,190,2);
- Line(306,10,306,190,2);
- GraphTextBackground := 33; GraphTextColor := 15;
- BackgroundOutTextXY(100,40,'Next Level: '+IntToStr(level,2));
- BackgroundOutTextXY(75,60,#24#32#25+' : Change level.');
- BackgroundOutTextXY(80,80,'Press Enter to start.');
- BackgroundOutTextXY(45,110,'Use Spacebar to pick up items');
- BackgroundOutTextXY(60,130,'Higher levels add objects');
- BackgroundOutTextXY(70,150,'and increase maze size');
- UpdateOuterArea := 2;
- FadeIn(BACKGNDPAGE,1000,Fade_Moiree1);
- Animate;
- FlushKey;
- REPEAT
- ch := GetKey;
- CASE ch OF
- #200 : IF level < 15 THEN Inc(level);
- #208 : IF level >1 THEN Dec(level);
- END; { Case }
- IF ch IN[#200,#208] THEN
- BEGIN
- BackgroundOutTextXY(100,40,'Next Level: '+IntToStr(level,2));
- Animate;
- END; { If }
- UNTIL ch = #13;
- END; { Selectlevel }
-
- {**********************************************************************}
- PROCEDURE TitleScreen;
- VAR x,y : Byte;
- BEGIN
- PlayMusic(hallking);
- SetPalette(blackpal,FALSE);
- SpriteN[0] := 40; { put block wall image on screen and make a copy }
- SpriteX[0] := 0;
- SpriteY[0] := 0;
- Animate;
- LadderPnt :=GetImage(0,0,15,15,1-Page);
- SpriteN[0] := 41; { put ladder image on screen and make a copy }
- SpriteX[0] := 0;
- SpriteY[0] := 0;
- Animate;
- graybrkPnt :=GetImage(0,0,15,15,1-Page);
- SpriteN[0] := 14; { put torches by title }
- SpriteX[0] := 80;
- SpriteY[0] := 20;
- SpriteN[1] := 14;
- SpriteX[1] := 230;
- SpriteY[1] := 20;
- SpriteX[2] := 80; { torch shadows }
- SpriteY[2] := 15;
- SpriteX[3] := 230;
- SpriteY[3] := 15;
- FOR x := 0 TO 19 DO PutImage(x*16,0,graybrkpnt,2); { draw ceiling }
- FOR y := 1 TO 11 DO PutImage(20,y*16,ladderpnt,2); { draw ladder }
- FOR x := 0 TO 19 DO PutImage(x*16,184,graybrkpnt,2); { draw floor }
- GraphTextColor := 200; GraphTextBackground := Black;
- BackgroundOutTextXY(131,28,'LADDERS');
- GraphTextColor := 79;
- BackgroundOutTextXY(100,50,'by Stan Ockers');
- GraphTextColor := 54;
- BackgroundOutTextXY(60,80,'written in Turbo Pascal 6.0');
- BackgroundOutTextXY(50,100,'using ANI-VGA by Kai Rohrbacher');
- GraphTextColor := 200;
- BackgroundOutTextXY(130,130,'FreeWare');
- GraphTextColor := 100;
- BackgroundOutTextXY(70,160,'press spacebar to start');
- UpdateOuterArea := 2;
- Animate;
- FadeToPalette(temppal,100);
- SpriteN[0] := 15; SpriteN[1] := 15; { light torches }
- SpriteN[2] := 22; SpriteN[3] := 22; { with background }
- WHILE NOT KeyPressed DO Animate;
- END; { TitleScreen }
-
- {**********************************************************************}
- BEGIN { Main Program }
- Init;
- TitleScreen;
- NewLevel:
- SelectLevel;
- Dejavu:
- MakeLevel;
- LightTorch; { in case one at room #1 }
- REPEAT
- IF KeyPressed THEN
- BEGIN
- ch := UpCase(GetKey);
- j := maze[row,col];
- CASE ch OF
- #203 : IF j AND 8 > 0 THEN LtOne;
- #205 : IF j AND 2 > 0 THEN RtOne;
- #200 : IF j AND 1 > 0 THEN UpOne;
- #208 : IF j AND 4 > 0 THEN DnOne;
- #32 : Pickup;
- END; { Case }
- IF{ (maze[row,col] AND 16 = 16) OR } (maze[row,col] AND 32 = 32)
- THEN Hitsprite; { deal with sprites }
- flushkey;
- END; { If KeyPressed }
- IF oops = 3 THEN
- BEGIN PlayMusic(funeral); Goto Dejavu; END;
- SpriteX[0] := StartVirtualX + 276;
- SpriteY[0] := StartVirtualY + 180;
- IF faceleft THEN SpriteN[1] := 1 { face forward }
- ELSE SpriteN[1] := 2;
- Animate;
- UNTIL (ch='Q') OR (ch=#27) OR (founddoor); {'Q' or ESC to quit}
- IF founddoor THEN
- BEGIN
- PlayMusic(hallking);
- SpriteN[50] := 23; { open door }
- Animate;
- Inc( level);
- Delay(2000);
- Goto NewLevel;
- END;
- CloseRoutines;
- END.
-